home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / MODEMPRO / HOST110.ZIP;1 / HOSTMSG.SCR < prev    next >
Encoding:
Text File  |  1994-05-07  |  7.5 KB  |  254 lines
  1. ' Message area routines for host mode.
  2. '
  3. ' DO NOT COMPILE THIS FILE BY ITSELF!
  4. '
  5. ' This file is a part of the complete HOST.SCR and will not compile
  6. ' alone.  To recompile the host scripts, select Scripts/Compile from
  7. ' the QmodemPro for Windows menu and select HOST.SCR in the "Compile
  8. ' script" dialog box.  This file will automatically be compiled as
  9. ' part of the full script.
  10.  
  11. sub PackMessages
  12.   dim numkept as integer, numdeleted as integer
  13.   dim oldhdrfile as integer, newhdrfile as integer
  14.   dim oldmsgfile as integer, newmsgfile as integer
  15.   print "Packing messages...";
  16.   numkept = 0
  17.   numdeleted = 0
  18.   oldhdrfile = freefile
  19.   open MsgHeaderFileName for random as #oldhdrfile len = len(TMessageHeader)
  20.   newhdrfile = freefile
  21.   open "hdr.$$$" for random as #newhdrfile len = len(TMessageHeader)
  22.   oldmsgfile = freefile
  23.   open MsgDetailFileName for input as #oldmsgfile
  24.   newmsgfile = freefile
  25.   open "msg.$$$" for output as #newmsgfile
  26.   while not eof(oldhdrfile)
  27.     dim Msg as TMessageHeader
  28.     get #oldhdrfile, , Msg
  29.     if Msg.Killed then
  30.       numdeleted = numdeleted + 1
  31.     else
  32.       seek #oldmsgfile, Msg.DetailPos
  33.       Msg.DetailPos = lof(newmsgfile) + 1
  34.       put #newhdrfile, lof(newhdrfile)+1, Msg
  35.       dim i as integer
  36.       dim s as string
  37.       for i = 0 to Msg.Lines-1
  38.         input #oldmsgfile, s
  39.         print #newmsgfile, s
  40.       next
  41.       numkept = numkept + 1
  42.     end if
  43.     print ".";
  44.   wend
  45.   close oldhdrfile, newhdrfile, oldmsgfile, newmsgfile
  46.   del MsgHeaderFileName
  47.   del MsgDetailFileName
  48.   name "hdr.$$$" as MsgHeaderFileName
  49.   name "msg.$$$" as MsgDetailFileName
  50.   print "Done."
  51.   print numdeleted; " message(s) removed."
  52.   print numkept; " message(s) remaining."
  53.   print
  54. catch err_fileopen
  55.   print
  56.   print
  57. end sub
  58.  
  59. sub WriteMessage(Msg as TMessageHeader)
  60.   dim hfile as integer, dfile as integer, i as integer
  61.   dim tried as integer
  62. tryagain:
  63.   hfile = freefile
  64.   open MsgHeaderFileName for random as #hfile len = len(TMessageHeader)
  65.   dfile = freefile
  66.   open MsgDetailFileName for append as #dfile
  67.   Msg.DetailPos = lof(dfile)+1
  68.   put #hfile, lof(hfile)+1, Msg
  69.   for i = 0 to Msg.Lines-1
  70.     print #dfile, MsgLines(i)
  71.   next
  72.   close dfile, hfile
  73. catch err_fileopen
  74.   if tried then
  75.     send #Port, "Error - could not create message file"
  76.   else
  77.     tried = true
  78.     hfile = freefile
  79.     open MsgHeaderFileName for append as #hfile
  80.     close hfile
  81.     goto tryagain
  82.   end if
  83. end sub
  84.  
  85. ' Enter a message
  86.  
  87. declare sub EnterMessage(receiver as string = "", subject as string = "")
  88. sub EnterMessage(receiver as string, subject as string)
  89.   dim Msg as TMessageHeader
  90.   dim tempuser as TUser
  91.   dim i as integer, j as integer, s as string
  92.   if receiver = "" then
  93.     do
  94.       Msg.Receiver = GetLine("     To: ")
  95.       if Msg.Receiver = "" or CallerHungUp then exit sub
  96.       if LookupUser(Msg.Receiver, tempuser) then
  97.         Msg.Receiver = tempuser.Name
  98.         exit do
  99.       elseif OemUpper(Msg.Receiver) = "ALL" then
  100.         exit do
  101.       else
  102.         send #Port,
  103.         send #Port, "The name ";chr(34);Msg.Receiver;chr(34);" was not found in the user list.  Send anyway? ";
  104.         if OemUpper(left(GetLine(), 1)) = "Y" then
  105.           exit do
  106.         end if
  107.       end if
  108.     loop
  109.     Msg.Subject  = GetLine("Subject: ")
  110.     if Msg.Subject = "" then exit sub
  111.   else
  112.     Msg.Receiver = receiver
  113.     Msg.Subject = subject
  114.   end if
  115.   Msg.Private = OemUpper(left(GetLine("Private? N"+BS), 1)) = "Y"
  116.   Msg.Sender = User.Name
  117.   Msg.DateTime = Date + " " + Time
  118.   send #Port,
  119.   send #Port, "Enter your message in the lines below."
  120.   send #Port, "Press enter on a line by itself to save your message."
  121.   send #Port, "    +"; string(70, "-"); "+"
  122.   do
  123.     dim wrapped as string
  124.     wrapped = ""
  125.     do while Msg.Lines <= MaxMsgLines
  126.       if Msg.Lines+1 < 10 then
  127.         send #Port, " ";
  128.       end if
  129.       send #Port, Msg.Lines+1; ": ";
  130.       MsgLines(Msg.Lines) = GetLine("", 72, wrapped)
  131.       if CallerHungUp then exit sub
  132.       if MsgLines(Msg.Lines) = "" then exit do
  133.       wrapped = ""
  134.       if len(MsgLines(Msg.Lines)) >= 72 then
  135.         if instr(MsgLines(Msg.Lines), " ") then
  136.           i = len(MsgLines(Msg.Lines))
  137.           j = 0
  138.           while mid(MsgLines(Msg.Lines), i, 1) <> " "
  139.             i = i - 1
  140.             j = j + 1
  141.           wend
  142.           wrapped = right(MsgLines(Msg.Lines), j)
  143.           MsgLines(Msg.Lines) = left(MsgLines(Msg.Lines), i-1)
  144.           send #Port, string(j, BS);
  145.           send #Port, string(j, " ");
  146.         end if
  147.         send #Port,
  148.       end if
  149.       Msg.Lines = Msg.Lines + 1
  150.     loop
  151.     send #Port,
  152.     if Msg.Lines > MaxMsgLines then
  153.       send #Port, "Maximum number of message lines reached."
  154.       send #Port,
  155.     end if
  156.     s = GetLine("(C)ontinue, (S)ave, or (A)bort? ")
  157.     select case OemUpper(left(s, 1))
  158.       case "S"
  159.         exit do
  160.       case "A"
  161.         send #Port,
  162.         send #Port, "Message aborted."
  163.         exit sub
  164.     end select
  165.     send #Port,
  166.   loop until CallerHungUp
  167.   send #Port,
  168.   send #Port, "Saving message...";
  169.   call WriteMessage(Msg)
  170.   send #Port, "Done."
  171. end sub
  172.  
  173. ' Read messages
  174.  
  175. sub ReadMessages
  176.   dim Msg as TMessageHeader
  177.   dim num as integer, i as integer, s as string
  178.   dim killable as integer
  179.   dim hfile as integer, dfile as integer
  180.   hfile = freefile
  181.   open MsgHeaderFileName for random as #hfile len = len(TMessageHeader)
  182.   dfile = freefile
  183.   open MsgDetailFileName for input as #dfile
  184.   num = val(GetLine("Message number to start with (1-"+str(lof(hfile))+")? "))
  185.   do while num > 0 and num <= lof(hfile) and not CallerHungUp
  186.     do
  187.       get #hfile, num, Msg
  188.       killable = (User.Name = Msg.Sender or User.Name = Msg.Receiver or User.Level > 0)
  189.       if User.Level > 0 then exit do
  190.       if not Msg.Killed and (not msg.Private or killable) then exit do
  191.       num = num + 1
  192.       if num > lof(hfile) then
  193.         send #Port,
  194.         send #Port, "End of messages."
  195.         exit sub
  196.       end if
  197.     loop
  198.     send #Port,
  199.     send #Port, " Number: "; num;
  200.     if killable and Msg.Killed then
  201.       send #Port, " (Killed)";
  202.     end if
  203.     send #Port, tab(40); "    Date: "; Msg.DateTime
  204.     send #Port, "     To: "; Msg.Receiver; tab(40); " Private: "; YesNo(Msg.Private)
  205.     send #Port, "   From: "; Msg.Sender;   tab(40); "Received: "; YesNo(Msg.Received)
  206.     send #Port, "Subject: "; Msg.Subject
  207.     send #Port,
  208.     seek #dfile, Msg.DetailPos
  209.     for i = 1 to Msg.Lines
  210.       input #dfile, s
  211.       send #Port, s
  212.     next
  213.     send #Port,
  214.     s = "[N]ext, [R]eply"
  215.     if killable then
  216.       s = s + ", [K]ill"
  217.     end if
  218.     s = s + ", [Q]uit? "
  219.     s = GetLine(s)
  220.     select case OemUpper(left(s, 1))
  221.       case "0" to "9"
  222.         i = val(s)
  223.         if i >= 1 and i <= lof(hfile) then
  224.           num = i
  225.         else
  226.           send #Port,
  227.           send #Port, "There is no message number "; i; "."
  228.         end if
  229.       case "N", ""
  230.         num = num + 1
  231.         if num > lof(hfile) then
  232.           send #Port,
  233.           send #Port, "End of messages."
  234.           exit do
  235.         end if
  236.       case "R"
  237.         call EnterMessage(Msg.Sender, Msg.Subject)
  238.       case "K"
  239.         if killable then
  240.           Msg.Killed = True
  241.           put #hfile, num, Msg
  242.           send #Port, "Message "; num; " killed."
  243.         end if
  244.       case "Q"
  245.         exit do
  246.     end select
  247.   loop
  248.   close hfile, dfile
  249. catch err_fileopen
  250.   send #Port, "No messages available to read"
  251. end sub
  252.  
  253.  
  254.